Assignment 6
Hyungue Lim
10/9/2019
Preparing
library(readxl)
library(tidyverse)## -- Attaching packages ------------------------------------------------ tidyverse 1.2.1 --## v ggplot2 3.2.1 v purrr 0.3.2
## v tibble 2.1.3 v dplyr 0.8.3
## v tidyr 1.0.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.4.0## -- Conflicts --------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(stringr)
setwd("C:/Users/student/Documents/MATH 421")
c2015<- read_excel("c2015.xlsx")
c2015 <- na.omit(c2015)
c2015 <- c2015 %>% filter_all(~!(.=="Unknown"))
c2015 <- c2015 %>% filter_all(~!(.=="Not Rep"))
c2015 <- c2015 %>% filter_all(~!(.==str_detect(.,"Not Rep")))
c2015 <- c2015 %>% filter_all(~!(.==str_detect(.,"Unknown")))
c2015 <- c2015 %>% filter_all(~!(.=="Not Reported"))
c2015$TRAV_SP <- c2015$TRAV_SP %>% str_replace("MPH", "")
c2015$TRAV_SP <- c2015$TRAV_SP %>% str_replace("Stopped", "0")
c2015$AGE <- c2015$AGE %>% str_replace("Less than 1", "0")
c2015$TRAV_SP <- as.numeric(c2015$TRAV_SP)
c2015$AGE <- as.numeric(c2015$AGE)
c2015 <- c2015 %>% filter(SEAT_POS == "Front Seat, Left Side")
library("gganimate")
library(gifski)
library("png")1
c2015 %>% group_by(SEX, INJ_SEV, MONTH) %>% summarize(mean = mean(TRAV_SP)) %>%
mutate(MONTH1=factor(MONTH, levels=month.name)) %>%
mutate(speed_above_below = ifelse(mean > mean(c2015$TRAV_SP), "above", "below"), standardized_speed = (mean - mean(c2015$TRAV_SP))/sd(c2015$TRAV_SP)) %>%
ggplot(aes(MONTH1, standardized_speed, label = standardized_speed)) + geom_bar(stat = "identity", aes(fill = speed_above_below), width=0.5) +
labs(title = "MONTH = {closest_state}", subtitle = "Normalized Monthly Average Speed", x="MONTH") +
coord_flip() +
transition_states(MONTH1)
2
c2015 %>% mutate(MONTH1=factor(MONTH, levels=month.name)) %>%
group_by(MONTH1, DRINKING, SEX) %>%
summarize(counting = n()) %>%
ungroup() %>%
group_by(MONTH1) %>%
mutate(total = sum(counting)) %>%
mutate(proportion = round(counting/total,2)) %>%
ungroup() %>%
group_by(MONTH1, DRINKING, SEX) %>%
ggplot(aes(x=DRINKING, y=counting, fill = SEX)) +
geom_col(position = "dodge") +
geom_text(aes(label=proportion),position = position_dodge(0.9)) +
transition_states(MONTH1) +
labs(title = "MONTH = {closest_state}")
3
debt <- tibble::tribble(
~Quarter, ~Mortgage, ~HE.Revolving, ~Auto.Loan, ~Credit.Card, ~Student.Loan, ~Other, ~Total,
"03:Q1", 4.94, 0.24, 0.64, 0.69, 0.24, 0.48, 7.23,
"03:Q2", 5.08, 0.26, 0.62, 0.69, 0.24, 0.49, 7.38,
"03:Q3", 5.18, 0.27, 0.68, 0.69, 0.25, 0.48, 7.56,
"03:Q4", 5.66, 0.3, 0.7, 0.7, 0.25, 0.45, 8.07,
"04:Q1", 5.84, 0.33, 0.72, 0.7, 0.26, 0.45, 8.29,
"04:Q2", 5.97, 0.37, 0.74, 0.7, 0.26, 0.42, 8.46,
"04:Q3", 6.21, 0.43, 0.75, 0.71, 0.33, 0.41, 8.83,
"04:Q4", 6.36, 0.47, 0.73, 0.72, 0.35, 0.42, 9.04,
"05:Q1", 6.51, 0.5, 0.73, 0.71, 0.36, 0.39, 9.21,
"05:Q2", 6.7, 0.53, 0.77, 0.72, 0.37, 0.4, 9.49,
"05:Q3", 6.91, 0.54, 0.83, 0.73, 0.38, 0.41, 9.79,
"05:Q4", 7.1, 0.57, 0.79, 0.74, 0.39, 0.42, 10,
"06:Q1", 7.44, 0.58, 0.79, 0.72, 0.43, 0.42, 10.38,
"06:Q2", 7.76, 0.59, 0.8, 0.74, 0.44, 0.42, 10.75,
"06:Q3", 8.05, 0.6, 0.82, 0.75, 0.45, 0.44, 11.11,
"06:Q4", 8.23, 0.6, 0.82, 0.77, 0.48, 0.41, 11.31,
"07:Q1", 8.42, 0.61, 0.79, 0.76, 0.51, 0.4, 11.5,
"07:Q2", 8.71, 0.62, 0.81, 0.8, 0.51, 0.41, 11.85,
"07:Q3", 8.93, 0.63, 0.82, 0.82, 0.53, 0.41, 12.13,
"07:Q4", 9.1, 0.65, 0.82, 0.84, 0.55, 0.42, 12.37,
"08:Q1", 9.23, 0.66, 0.81, 0.84, 0.58, 0.42, 12.54,
"08:Q2", 9.27, 0.68, 0.81, 0.85, 0.59, 0.4, 12.6,
"08:Q3", 9.29, 0.69, 0.81, 0.86, 0.61, 0.41, 12.68,
"08:Q4", 9.26, 0.71, 0.79, 0.87, 0.64, 0.41, 12.67,
"09:Q1", 9.14, 0.71, 0.77, 0.84, 0.66, 0.41, 12.53,
"09:Q2", 9.06, 0.71, 0.74, 0.82, 0.68, 0.39, 12.41,
"09:Q3", 8.94, 0.71, 0.74, 0.81, 0.69, 0.38, 12.28,
"09:Q4", 8.84, 0.71, 0.72, 0.8, 0.72, 0.38, 12.17,
"10:Q1", 8.83, 0.7, 0.7, 0.76, 0.76, 0.36, 12.12,
"10:Q2", 8.7, 0.68, 0.7, 0.74, 0.76, 0.35, 11.94,
"10:Q3", 8.61, 0.67, 0.71, 0.73, 0.78, 0.34, 11.84,
"10:Q4", 8.45, 0.67, 0.71, 0.73, 0.81, 0.34, 11.71,
"11:Q1", 8.54, 0.64, 0.71, 0.7, 0.84, 0.33, 11.75,
"11:Q2", 8.52, 0.62, 0.71, 0.69, 0.85, 0.33, 11.73,
"11:Q3", 8.4, 0.64, 0.73, 0.69, 0.87, 0.33, 11.66,
"11:Q4", 8.27, 0.63, 0.73, 0.7, 0.87, 0.33, 11.54,
"12:Q1", 8.19, 0.61, 0.74, 0.68, 0.9, 0.32, 11.44,
"12:Q2", 8.15, 0.59, 0.75, 0.67, 0.91, 0.31, 11.38,
"12:Q3", 8.03, 0.57, 0.77, 0.67, 0.96, 0.31, 11.31,
"12:Q4", 8.03, 0.56, 0.78, 0.68, 0.97, 0.32, 11.34,
"13:Q1", 7.93, 0.55, 0.79, 0.66, 0.99, 0.31, 11.23,
"13:Q2", 7.84, 0.54, 0.81, 0.67, 0.99, 0.3, 11.15,
"13:Q3", 7.9, 0.54, 0.85, 0.67, 1.03, 0.3, 11.28,
"13:Q4", 8.05, 0.53, 0.86, 0.68, 1.08, 0.32, 11.52,
"14:Q1", 8.17, 0.53, 0.88, 0.66, 1.11, 0.31, 11.65,
"14:Q2", 8.1, 0.52, 0.91, 0.67, 1.12, 0.32, 11.63,
"14:Q3", 8.13, 0.51, 0.93, 0.68, 1.13, 0.33, 11.71,
"14:Q4", 8.17, 0.51, 0.96, 0.7, 1.16, 0.34, 11.83,
"15:Q1", 8.17, 0.51, 0.97, 0.68, 1.19, 0.33, 11.85,
"15:Q2", 8.12, 0.5, 1.01, 0.7, 1.19, 0.34, 11.85,
"15:Q3", 8.26, 0.49, 1.05, 0.71, 1.2, 0.35, 12.07,
"15:Q4", 8.25, 0.49, 1.06, 0.73, 1.23, 0.35, 12.12,
"16:Q1", 8.37, 0.49, 1.07, 0.71, 1.26, 0.35, 12.25,
"16:Q2", 8.36, 0.48, 1.1, 0.73, 1.26, 0.36, 12.29,
"16:Q3", 8.35, 0.47, 1.14, 0.75, 1.28, 0.37, 12.35,
"16:Q4", 8.48, 0.47, 1.16, 0.78, 1.31, 0.38, 12.58,
"17:Q1", 8.63, 0.46, 1.17, 0.76, 1.34, 0.37, 12.73,
"17:Q2", 8.69, 0.45, 1.19, 0.78, 1.34, 0.38, 12.84,
"17:Q3", 8.74, 0.45, 1.21, 0.81, 1.36, 0.39, 12.96,
"17:Q4", 8.88, 0.44, 1.22, 0.83, 1.38, 0.39, 13.15,
"18:Q1", 8.94, 0.44, 1.23, 0.82, 1.41, 0.39, 13.21,
"18:Q2", 9, 0.43, 1.24, 0.83, 1.41, 0.39, 13.29,
"18:Q3", 9.14, 0.42, 1.27, 0.84, 1.44, 0.4, 13.51,
"18:Q4", 9.12, 0.41, 1.27, 0.87, 1.46, 0.41, 13.54,
"19:Q1", 9.24, 0.41, 1.28, 0.85, 1.49, 0.4, 13.67,
"19:Q2", 9.41, 0.4, 1.3, 0.87, 1.48, 0.41, 13.86
)
debt %>% ggplot(aes(Student.Loan, Credit.Card)) +
geom_line()
4
debt %>% ggplot(aes(Student.Loan, Credit.Card)) +
geom_line() +
geom_segment(aes(xend=1.5, yend=Credit.Card)) +
geom_point() +
geom_text(aes(x=1.6, label=Credit.Card)) +
transition_reveal(Student.Loan) +
ease_aes()
5
debt %>% mutate(date = seq(as.Date("2003/01/01"), by="quarter", length.out = 66)) %>%
ggplot(aes(date, Student.Loan)) +
geom_line()
6
debt %>% mutate(date = seq(as.Date("2003/01/01"), by="quarter", length.out = 66)) %>% ggplot(aes(date, Student.Loan)) +
geom_line() +
transition_reveal(date) +
ease_aes()
7
debt %>% mutate(date = seq(as.Date("2003/01/01"), by="quarter", length.out = 66)) %>% ggplot(aes(date, Student.Loan)) +
geom_line() +
geom_segment(aes(xend=as.Date("2019/04/01"), yend=Student.Loan)) +
geom_point() +
geom_text(aes(x=as.Date("2019/06/01"), label=Student.Loan)) +
transition_reveal(date) +
ease_aes()
8
debt %>% mutate(Quarter1 = gsub("^.*?:","",debt$Quarter)) %>%
select(-Quarter) %>%
mutate(date = seq(as.Date("2003/01/01"), by="quarter", length.out = 66)) %>%
gather(Debt_Category, Debt_Amount, Mortgage:Other) %>%
ggplot(aes(date, Debt_Amount, col=Debt_Category)) +
geom_line() +
geom_segment(aes(xend=as.Date("2019/04/01"), yend=Debt_Amount), linetype=2) +
geom_point() +
geom_text(aes(x=as.Date("2019/06/01"), label=Debt_Category), hjust=0) +
coord_cartesian(clip = 'off') +
transition_reveal(date) +
ease_aes()
9.1
# Mortgage accounts for the most of the total debt
# Mortgage VS Total
debt %>% mutate(Quarter1 = gsub("^.*?:","",debt$Quarter)) %>%
select(-Quarter) %>%
mutate(date = seq(as.Date("2003/01/01"), by="quarter", length.out = 66)) %>%
gather(Debt_Category, Debt_Amount, c(Mortgage,Total)) %>%
ggplot(aes(date, Debt_Amount, col=Debt_Category)) +
geom_line() +
geom_segment(aes(xend=as.Date("2019/04/01"), yend=Debt_Amount), linetype=2) +
geom_point() +
geom_text(aes(x=as.Date("2019/06/01"), label=Debt_Category), hjust=0) +
coord_cartesian(clip = 'off') +
transition_reveal(date) +
ease_aes() +
labs(title = "Mortgage VS Total Debt in the U.S.", x="Date", y="Debt in Trillion Dollars")
9.2
# Everything Else
debt %>% mutate(Quarter1 = gsub("^.*?:","",debt$Quarter)) %>%
select(-Quarter, -Total, -Mortgage) %>%
mutate(date = seq(as.Date("2003/01/01"), by="quarter", length.out = 66)) %>%
gather(Debt_Category, Debt_Amount, HE.Revolving:Other) %>%
ggplot(aes(date, Debt_Amount, col=Debt_Category)) +
geom_line() +
geom_segment(aes(xend=as.Date("2019/04/01"), yend=Debt_Amount), linetype=2) +
geom_point() +
geom_text(aes(x=as.Date("2019/06/01"), label=Debt_Category), hjust=0) +
coord_cartesian(clip = 'off') +
transition_reveal(date) +
ease_aes() +
labs(title = "Various Debts in the U.S.", x="Date", y="Debt in Trillion Dollars") +
theme(plot.margin=margin(1,2,1,1,"cm"), legend.position = "bottom")
### Mortgage has been the biggest factor of the total debt in the U.S. for a long time. Student loan has been soaring, even during the great recession. Debts generally decreased for awhile after the great recession arount 2008 - 2009. However, soon after the great recession, debts start to rise again. On the other hand, revolving debt has bee steadily decreasing.
10.1
gdp <- tibble::tribble(
~V1, ~V2,
"Mar-2000", 12.924,
"Jun-2000", 13.161,
"Sep-2000", 13.178,
"Dec-2000", 13.261,
"Mar-2001", 13.223,
"Jun-2001", 13.3,
"Sep-2001", 13.245,
"Dec-2001", 13.281,
"Mar-2002", 13.397,
"Jun-2002", 13.478,
"Sep-2002", 13.538,
"Dec-2002", 13.559,
"Mar-2003", 13.634,
"Jun-2003", 13.752,
"Sep-2003", 13.985,
"Dec-2003", 14.146,
"Mar-2004", 14.221,
"Jun-2004", 14.33,
"Sep-2004", 14.465,
"Dec-2004", 14.61,
"Mar-2005", 14.772,
"Jun-2005", 14.84,
"Sep-2005", 14.972,
"Dec-2005", 15.067,
"Mar-2006", 15.267,
"Jun-2006", 15.303,
"Sep-2006", 15.326,
"Dec-2006", 15.457,
"Mar-2007", 15.493,
"Jun-2007", 15.582,
"Sep-2007", 15.667,
"Dec-2007", 15.762,
"Mar-2008", 15.671,
"Jun-2008", 15.752,
"Sep-2008", 15.667,
"Dec-2008", 15.328,
"Mar-2009", 15.156,
"Jun-2009", 15.134,
"Sep-2009", 15.189,
"Dec-2009", 15.356,
"Mar-2010", 15.415,
"Jun-2010", 15.557,
"Sep-2010", 15.672,
"Dec-2010", 15.751,
"Mar-2011", 15.713,
"Jun-2011", 15.825,
"Sep-2011", 15.821,
"Dec-2011", 16.004,
"Mar-2012", 16.129,
"Jun-2012", 16.199,
"Sep-2012", 16.221,
"Dec-2012", 16.239,
"Mar-2013", 16.383,
"Jun-2013", 16.403,
"Sep-2013", 16.532,
"Dec-2013", 16.664,
"Mar-2014", 16.617,
"Jun-2014", 16.842,
"Sep-2014", 17.047,
"Dec-2014", 17.143,
"Mar-2015", 17.278,
"Jun-2015", 17.406,
"Sep-2015", 17.463,
"Dec-2015", 17.469,
"Mar-2016", 17.557,
"Jun-2016", 17.639,
"Sep-2016", 17.735,
"Dec-2016", 17.824,
"Mar-2017", 17.925,
"Jun-2017", 18.021,
"Sep-2017", 18.164,
"Dec-2017", 18.323,
"Mar-2018", 18.438,
"Jun-2018", 18.598,
"Sep-2018", 18.733,
"Dec-2018", 18.784,
"Mar-2019", 18.927,
"Jun-2019", 19.024
)
names(gdp) <- c("quarters", "GDP")
gdp %>% mutate(date = seq(as.Date("2000/03/01"), by="quarter", length.out = 78)) %>% ggplot(aes(date, GDP, col="red")) +
geom_segment(aes(xend=as.Date("2019/06/01"), yend=GDP), linetype=2) +
geom_point() +
geom_text(aes(x=as.Date("2019/09/01"), label=date), hjust=0) +
coord_cartesian(clip = 'off') +
transition_states(date) +
labs(title = "Changes in GDP", x="Year", y="GDP in Millions of Dollars, Chained 2012") +
theme(legend.position="none", plot.margin=margin(1,2,1,1,"cm"))
10.2
labor <- tibble::tribble(
~V1, ~V2, ~V3,
"Jan-2000", 4, 67.3,
"Feb-2000", 4.1, 67.3,
"Mar-2000", 4, 67.3,
"Apr-2000", 3.8, 67.3,
"May-2000", 4, 67.1,
"Jun-2000", 4, 67.1,
"Jul-2000", 4, 66.9,
"Aug-2000", 4.1, 66.9,
"Sep-2000", 3.9, 66.9,
"Oct-2000", 3.9, 66.8,
"Nov-2000", 3.9, 66.9,
"Dec-2000", 3.9, 67,
"Jan-2001", 4.2, 67.2,
"Feb-2001", 4.2, 67.1,
"Mar-2001", 4.3, 67.2,
"Apr-2001", 4.4, 66.9,
"May-2001", 4.3, 66.7,
"Jun-2001", 4.5, 66.7,
"Jul-2001", 4.6, 66.8,
"Aug-2001", 4.9, 66.5,
"Sep-2001", 5, 66.8,
"Oct-2001", 5.3, 66.7,
"Nov-2001", 5.5, 66.7,
"Dec-2001", 5.7, 66.7,
"Jan-2002", 5.7, 66.5,
"Feb-2002", 5.7, 66.8,
"Mar-2002", 5.7, 66.6,
"Apr-2002", 5.9, 66.7,
"May-2002", 5.8, 66.7,
"Jun-2002", 5.8, 66.6,
"Jul-2002", 5.8, 66.5,
"Aug-2002", 5.7, 66.6,
"Sep-2002", 5.7, 66.7,
"Oct-2002", 5.7, 66.6,
"Nov-2002", 5.9, 66.4,
"Dec-2002", 6, 66.3,
"Jan-2003", 5.8, 66.4,
"Feb-2003", 5.9, 66.4,
"Mar-2003", 5.9, 66.3,
"Apr-2003", 6, 66.4,
"May-2003", 6.1, 66.4,
"Jun-2003", 6.3, 66.5,
"Jul-2003", 6.2, 66.2,
"Aug-2003", 6.1, 66.1,
"Sep-2003", 6.1, 66.1,
"Oct-2003", 6, 66.1,
"Nov-2003", 5.8, 66.1,
"Dec-2003", 5.7, 65.9,
"Jan-2004", 5.7, 66.1,
"Feb-2004", 5.6, 66,
"Mar-2004", 5.8, 66,
"Apr-2004", 5.6, 65.9,
"May-2004", 5.6, 66,
"Jun-2004", 5.6, 66.1,
"Jul-2004", 5.5, 66.1,
"Aug-2004", 5.4, 66,
"Sep-2004", 5.4, 65.8,
"Oct-2004", 5.5, 65.9,
"Nov-2004", 5.4, 66,
"Dec-2004", 5.4, 65.9,
"Jan-2005", 5.3, 65.8,
"Feb-2005", 5.4, 65.9,
"Mar-2005", 5.2, 65.9,
"Apr-2005", 5.2, 66.1,
"May-2005", 5.1, 66.1,
"Jun-2005", 5, 66.1,
"Jul-2005", 5, 66.1,
"Aug-2005", 4.9, 66.2,
"Sep-2005", 5, 66.1,
"Oct-2005", 5, 66.1,
"Nov-2005", 5, 66,
"Dec-2005", 4.9, 66,
"Jan-2006", 4.7, 66,
"Feb-2006", 4.8, 66.1,
"Mar-2006", 4.7, 66.2,
"Apr-2006", 4.7, 66.1,
"May-2006", 4.6, 66.1,
"Jun-2006", 4.6, 66.2,
"Jul-2006", 4.7, 66.1,
"Aug-2006", 4.7, 66.2,
"Sep-2006", 4.5, 66.1,
"Oct-2006", 4.4, 66.2,
"Nov-2006", 4.5, 66.3,
"Dec-2006", 4.4, 66.4,
"Jan-2007", 4.6, 66.4,
"Feb-2007", 4.5, 66.3,
"Mar-2007", 4.4, 66.2,
"Apr-2007", 4.5, 65.9,
"May-2007", 4.4, 66,
"Jun-2007", 4.6, 66,
"Jul-2007", 4.7, 66,
"Aug-2007", 4.6, 65.8,
"Sep-2007", 4.7, 66,
"Oct-2007", 4.7, 65.8,
"Nov-2007", 4.7, 66,
"Dec-2007", 5, 66,
"Jan-2008", 5, 66.2,
"Feb-2008", 4.9, 66,
"Mar-2008", 5.1, 66.1,
"Apr-2008", 5, 65.9,
"May-2008", 5.4, 66.1,
"Jun-2008", 5.6, 66.1,
"Jul-2008", 5.8, 66.1,
"Aug-2008", 6.1, 66.1,
"Sep-2008", 6.1, 66,
"Oct-2008", 6.5, 66,
"Nov-2008", 6.8, 65.9,
"Dec-2008", 7.3, 65.8,
"Jan-2009", 7.8, 65.7,
"Feb-2009", 8.3, 65.8,
"Mar-2009", 8.7, 65.6,
"Apr-2009", 9, 65.7,
"May-2009", 9.4, 65.7,
"Jun-2009", 9.5, 65.7,
"Jul-2009", 9.5, 65.5,
"Aug-2009", 9.6, 65.4,
"Sep-2009", 9.8, 65.1,
"Oct-2009", 10, 65,
"Nov-2009", 9.9, 65,
"Dec-2009", 9.9, 64.6,
"Jan-2010", 9.8, 64.8,
"Feb-2010", 9.8, 64.9,
"Mar-2010", 9.9, 64.9,
"Apr-2010", 9.9, 65.2,
"May-2010", 9.6, 64.9,
"Jun-2010", 9.4, 64.6,
"Jul-2010", 9.4, 64.6,
"Aug-2010", 9.5, 64.7,
"Sep-2010", 9.5, 64.6,
"Oct-2010", 9.4, 64.4,
"Nov-2010", 9.8, 64.6,
"Dec-2010", 9.3, 64.3,
"Jan-2011", 9.1, 64.2,
"Feb-2011", 9, 64.1,
"Mar-2011", 9, 64.2,
"Apr-2011", 9.1, 64.2,
"May-2011", 9, 64.1,
"Jun-2011", 9.1, 64,
"Jul-2011", 9, 64,
"Aug-2011", 9, 64.1,
"Sep-2011", 9, 64.2,
"Oct-2011", 8.8, 64.1,
"Nov-2011", 8.6, 64.1,
"Dec-2011", 8.5, 64,
"Jan-2012", 8.3, 63.7,
"Feb-2012", 8.3, 63.8,
"Mar-2012", 8.2, 63.8,
"Apr-2012", 8.2, 63.7,
"May-2012", 8.2, 63.7,
"Jun-2012", 8.2, 63.8,
"Jul-2012", 8.2, 63.7,
"Aug-2012", 8.1, 63.5,
"Sep-2012", 7.8, 63.6,
"Oct-2012", 7.8, 63.8,
"Nov-2012", 7.7, 63.6,
"Dec-2012", 7.9, 63.7,
"Jan-2013", 8, 63.7,
"Feb-2013", 7.7, 63.4,
"Mar-2013", 7.5, 63.3,
"Apr-2013", 7.6, 63.4,
"May-2013", 7.5, 63.4,
"Jun-2013", 7.5, 63.4,
"Jul-2013", 7.3, 63.3,
"Aug-2013", 7.2, 63.3,
"Sep-2013", 7.2, 63.2,
"Oct-2013", 7.2, 62.8,
"Nov-2013", 6.9, 63,
"Dec-2013", 6.7, 62.9,
"Jan-2014", 6.6, 62.9,
"Feb-2014", 6.7, 62.9,
"Mar-2014", 6.7, 63.1,
"Apr-2014", 6.2, 62.8,
"May-2014", 6.3, 62.9,
"Jun-2014", 6.1, 62.8,
"Jul-2014", 6.2, 62.9,
"Aug-2014", 6.1, 62.9,
"Sep-2014", 5.9, 62.8,
"Oct-2014", 5.7, 62.9,
"Nov-2014", 5.8, 62.9,
"Dec-2014", 5.6, 62.8,
"Jan-2015", 5.7, 62.9,
"Feb-2015", 5.5, 62.7,
"Mar-2015", 5.4, 62.6,
"Apr-2015", 5.4, 62.7,
"May-2015", 5.6, 62.9,
"Jun-2015", 5.3, 62.6,
"Jul-2015", 5.2, 62.6,
"Aug-2015", 5.1, 62.6,
"Sep-2015", 5, 62.4,
"Oct-2015", 5, 62.5,
"Nov-2015", 5.1, 62.6,
"Dec-2015", 5, 62.7,
"Jan-2016", 4.9, 62.7,
"Feb-2016", 4.9, 62.8,
"Mar-2016", 5, 62.9,
"Apr-2016", 5, 62.8,
"May-2016", 4.8, 62.7,
"Jun-2016", 4.9, 62.7,
"Jul-2016", 4.8, 62.8,
"Aug-2016", 4.9, 62.9,
"Sep-2016", 5, 62.9,
"Oct-2016", 4.9, 62.8,
"Nov-2016", 4.7, 62.7,
"Dec-2016", 4.7, 62.7,
"Jan-2017", 4.7, 62.9,
"Feb-2017", 4.7, 62.9,
"Mar-2017", 4.4, 62.9,
"Apr-2017", 4.4, 62.9,
"May-2017", 4.4, 62.8,
"Jun-2017", 4.3, 62.8,
"Jul-2017", 4.3, 62.9,
"Aug-2017", 4.4, 62.9,
"Sep-2017", 4.2, 63.1,
"Oct-2017", 4.1, 62.7,
"Nov-2017", 4.2, 62.8,
"Dec-2017", 4.1, 62.7,
"Jan-2018", 4.1, 62.7,
"Feb-2018", 4.1, 63,
"Mar-2018", 4, 62.9,
"Apr-2018", 3.9, 62.8,
"May-2018", 3.8, 62.8,
"Jun-2018", 4, 62.9,
"Jul-2018", 3.9, 62.9,
"Aug-2018", 3.8, 62.7,
"Sep-2018", 3.7, 62.7,
"Oct-2018", 3.8, 62.9,
"Nov-2018", 3.7, 62.9,
"Dec-2018", 3.9, 63.1,
"Jan-2019", 4, 63.2,
"Feb-2019", 3.8, 63.2,
"Mar-2019", 3.8, 63,
"Apr-2019", 3.6, 62.8,
"May-2019", 3.6, 62.8,
"Jun-2019", 3.7, 62.9,
"Jul-2019", 3.7, 63,
"Aug-2019", 3.7, 63.2
)
names(labor) <- c("months", "UE", "LF_participation_rate")
labor %>% mutate(date = seq(as.Date("2000/01/01"), by="month", length.out = 236)) %>% gather(labor_category, labor_value, UE:LF_participation_rate) %>%
ggplot(aes(date, labor_value, col=labor_category)) +
geom_line() +
geom_segment(aes(xend=as.Date("2019/08/01"), yend=labor_value), linetype=2) +
geom_point() +
geom_text(aes(x=as.Date("2019/09/01"), label=labor_category), hjust=0) +
coord_cartesian(clip = 'off') +
transition_reveal(date) +
ease_aes() +
labs(title = "Changes in Labor Related Indicators", x="Year", y="Unemployment Rate and Labor Force Participation Rate")
10.3
housing <- tibble::tribble(
~V1, ~V2,
200001, 343,
200002, 394,
200003, 380,
200004, 375,
200005, 329,
200006, 351,
200007, 341,
200008, 329,
200009, 314,
200010, 312,
200011, 322,
200012, 320,
200101, 323,
200102, 325,
200103, 347,
200104, 352,
200105, 343,
200106, 333,
200107, 344,
200108, 331,
200109, 324,
200110, 300,
200111, 326,
200112, 314,
200201, 340,
200202, 330,
200203, 353,
200204, 331,
200205, 342,
200206, 342,
200207, 348,
200208, 356,
200209, 359,
200210, 347,
200211, 338,
200212, 335,
200301, 341,
200302, 331,
200303, 324,
200304, 308,
200305, 319,
200306, 328,
200307, 359,
200308, 355,
200309, 365,
200310, 356,
200311, 370,
200312, 378,
200401, 383,
200402, 375,
200403, 361,
200404, 363,
200405, 351,
200406, 329,
200407, 319,
200408, 321,
200409, 337,
200410, 365,
200411, 362,
200412, 355,
200501, 352,
200502, 383,
200503, 367,
200504, 366,
200505, 332,
200506, 354,
200507, 330,
200508, 349,
200509, 353,
200510, 351,
200511, 342,
200512, 343,
200601, 385,
200602, 377,
200603, 378,
200604, 331,
200605, 350,
200606, 344,
200607, 345,
200608, 317,
200609, 312,
200610, 300,
200611, 298,
200612, 320,
200701, 320,
200702, 323,
200703, 288,
200704, 292,
200705, 290,
200706, 298,
200707, 305,
200708, 334,
200709, 311,
200710, 336,
200711, 333,
200712, 327,
200801, 302,
200802, 307,
200803, 322,
200804, 329,
200805, 301,
200806, 341,
200807, 334,
200808, 315,
200809, 276,
200810, 252,
200811, 237,
200812, 195,
200901, 161,
200902, 171,
200903, 169,
200904, 156,
200905, 125,
200906, 109,
200907, 107,
200908, 96,
200909, 86,
200910, 77,
200911, 75,
200912, 82,
201001, 97,
201002, 93,
201003, 92,
201004, 98,
201005, 114,
201006, 113,
201007, 112,
201008, 131,
201009, 149,
201010, 144,
201011, 114,
201012, 103,
201101, 134,
201102, 145,
201103, 166,
201104, 145,
201105, 152,
201106, 153,
201107, 170,
201108, 176,
201109, 195,
201110, 189,
201111, 216,
201112, 196,
201201, 208,
201202, 205,
201203, 222,
201204, 237,
201205, 221,
201206, 224,
201207, 215,
201208, 225,
201209, 231,
201210, 258,
201211, 274,
201212, 310,
201301, 303,
201302, 319,
201303, 327,
201304, 315,
201305, 319,
201306, 265,
201307, 278,
201308, 266,
201309, 282,
201310, 296,
201311, 335,
201312, 362,
201401, 359,
201402, 342,
201403, 330,
201404, 355,
201405, 357,
201406, 353,
201407, 364,
201408, 359,
201409, 376,
201410, 358,
201411, 359,
201412, 357,
201501, 360,
201502, 347,
201503, 341,
201504, 363,
201505, 388,
201506, 443,
201507, 420,
201508, 427,
201509, 416,
201510, 407,
201511, 405,
201512, 378,
201601, 377,
201602, 369,
201603, 359,
201604, 373,
201605, 381,
201606, 403,
201607, 426,
201608, 440,
201609, 393,
201610, 392,
201611, 354,
201612, 415,
201701, 403,
201702, 432,
201703, 395,
201704, 364,
201705, 337,
201706, 345,
201707, 354,
201708, 341,
201709, 324,
201710, 332,
201711, 351,
201712, 363,
201801, 388,
201802, 402,
201803, 428,
201804, 402,
201805, 404,
201806, 365,
201807, 348,
201808, 347,
201809, 357,
201810, 364,
201811, 367,
201812, 357,
201901, 350,
201902, 337,
201903, 349,
201904, 377,
201905, 408,
201906, 411,
201907, 380
)
names(housing) <- c("month", "housing_start")
variables <- cbind(labor[-236,], housing)
variables %>% mutate(date = seq(as.Date("2000/01/01"), by="month", length.out = 235)) %>% select(-months, -month) %>% mutate(UE1 = UE*100) %>%
gather(indicator, indicator_value, c(UE1,housing_start)) %>%
ggplot(aes(date, indicator_value, col=indicator)) +
geom_line() +
geom_segment(aes(xend=as.Date("2019/08/01"), yend=indicator_value), linetype=2) +
geom_point() +
geom_text(aes(x=as.Date("2019/09/01"), label=indicator), hjust=0) +
coord_cartesian(clip = 'off') +
transition_reveal(date) +
ease_aes() +
labs(title = "Unemployment Rate *100 and Housing Start", x="Year", y="Unemployment Rate and Housing Start (Multifamily, 3-month moving average)")